home *** CD-ROM | disk | FTP | other *** search
/ Young Minds / Young Minds Interactive CD-ROM.ISO / dungeon / dinit.f < prev    next >
Encoding:
Text File  |  1987-09-16  |  10.7 KB  |  548 lines
  1. #include "files.h"
  2.  
  3. #ifndef INDXFILE
  4. #define INDXFILE '/usr/games/lib/dunlib/dindx.dat'
  5. #endif
  6. #ifndef TEXTFILE
  7. #define TEXTFILE '/usr/games/lib/dunlib/dtext.dat'
  8. #endif
  9. #ifndef WIZARDID
  10. #define WIZARDID 0
  11. #endif
  12.  
  13. C INIT-- DUNGEON INITIALIZATION SUBROUTINE
  14. C
  15. C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  16. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  17. C WRITTEN BY R. M. SUPNIK
  18. C
  19. C DECLARATIONS
  20. C
  21.     LOGICAL FUNCTION INIT(X)
  22.     IMPLICIT INTEGER (A-Z)
  23. #ifndef PDP
  24.     LOGICAL PROTCT
  25.     INTEGER DATARRY(3)
  26. #endif PDP
  27. #include "parser.h"
  28. #include "gamestate.h"
  29. #include "state.h"
  30. #include "screen.h"
  31. #include "mindex.h"
  32. C
  33. C MISCELLANEOUS VARIABLES
  34. C
  35.     COMMON /STAR/ MBASE,STRBIT
  36.     COMMON /VERS/ VMAJ,VMIN,VEDIT
  37.     COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
  38. #include "io.h"
  39. #include "debug.h"
  40.     COMMON /HYPER/ HFACTR
  41. #include "rooms.h"
  42. #include "rflag.h"
  43. #include "rindex.h"
  44. #include "exits.h"
  45. #include "curxt.h"
  46. #include "xpars.h"
  47. #include "objects.h"
  48. #include "oindex.h"
  49. #include "clock.h"
  50. #include "villians.h"
  51. #include "advers.h"
  52. #include "flags.h"
  53. C INIT, PAGE 2
  54. C
  55. #ifndef PDP
  56. C FIRST CHECK FOR PROTECTION VIOLATION
  57. C
  58.     IF(PROTCT(X)) GO TO 10000
  59. C                        !PROTECTION VIOLATION?
  60.     PRINT 10100
  61. 10100    FORMAT(' There appears before you a threatening figure clad '
  62. &    'all over'/' in heavy black armor.  His legs seem like the '
  63. &    'massive trunk'/' of the oak tree.  His broad shoulders and '
  64. &    'helmeted head loom'/' high over your own puny frame, and '
  65. &    'you realize that his powerful'/' arms could easily crush the '
  66. &    'very life from your body.  There'/' hangs from his belt a '
  67. &    'veritable arsenal of deadly weapons:'/' sword, mace, ball '
  68. &    'and chain, dagger, lance, and trident.'/' He speaks with a '
  69. &    'commanding voice:'//20X,'"You shall not pass."'//' As '
  70. &    'he grabs you by the neck all grows dim about you.')
  71.     CALL EXIT
  72. #endif PDP
  73. C
  74. C NOW START INITIALIZATION PROPER
  75. C
  76. #ifdef PDP
  77. C
  78. C   Note: arrays FLAGS & SWITCH are initialized in the following
  79. C           DATA statements, instead of using DO loops and assignments
  80. C           as used before.  This saves some code space.
  81. C
  82.     DATA FLAGS/.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
  83. &           .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
  84. &           .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
  85. &            .TRUE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.TRUE.,
  86. &           .FALSE.,.FALSE.,.FALSE.,.TRUE.,.FALSE.,.FALSE.,
  87. &           .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
  88. &           .FALSE.,.FALSE.,.FALSE.,.TRUE.,.TRUE.,.FALSE.,
  89. &            .TRUE.,.FALSE.,.FALSE.,.FALSE./
  90. C
  91.     DATA SWITCH/0,0,0,0,0,0,0,0,0,
  92. &            4,0,270,0,0,0,0,0,
  93. &            1,1,0,0,10/
  94. C
  95. C   Note: SWITCH(13) or MLOC is initialized equal to MRB later.
  96. C
  97. C
  98.     DATA LTSHFT/10/
  99.     DATA EGSCOR/0/
  100.     DATA EGMXSC/0/
  101.     DATA MXLOAD/100/
  102.     DATA RWSCOR/0/
  103.     DATA DEATHS/0/
  104.     DATA MOVES/0/
  105.     DATA PLTIME/0/
  106.     DATA MUNGRM/0/
  107.     DATA HS/0/
  108.     DATA PRSA/0/
  109.     DATA PRSI/0/
  110.     DATA PRSO/0/
  111.     DATA PRSCON/1/
  112.     DATA OFLAG/0/
  113.     DATA OACT/0/
  114.     DATA OSLOT/0/
  115.     DATA OPREP/0/
  116.     DATA ONAME/0/
  117.     DATA THFFLG/.FALSE./
  118.     DATA THFACT/.TRUE./
  119.     DATA SWDACT/.FALSE./
  120.     DATA SWDSTA/0/
  121. C
  122.     DATA RECNO/1/
  123.     DATA MBASE/0/
  124.     DATA INPCH/5/
  125.     DATA OUTCH/5/
  126.     DATA DBCH/2/
  127. C
  128. C INIT, PAGE 3
  129. C
  130. C
  131.     DATA DBGFLG/0/
  132.     DATA PRSFLG/0/
  133.     DATA GDTFLG/0/
  134. C
  135.     FROMDR=0
  136.     SCOLRM=0
  137.     SCOLAC=0
  138.     INIT=.FALSE.        
  139.     MLOC=MRB
  140. C
  141. C INIT, PAGE 4
  142. C
  143. C NOW RESTORE FROM EXISTING INDEX FILE.
  144. C
  145.     call intrd(i)
  146.     call intrd(j)
  147.     call intrd(k)
  148.     IF((I.NE.VMAJ).OR.(J.NE.VMIN))
  149. &        GO TO 1925            
  150. C
  151.     call intrd(MXSCOR)
  152.     call intrd(STRBIT)
  153.     call intrd(EGMXSC)
  154. C
  155.     call intrd(RLNT)
  156.     call intrd(RDESC2)
  157.     call aryrd(200,RDESC1)
  158.     call aryrd(200,REXIT)
  159.     call aryrd(200,RACTIO)
  160.     call aryrd(200,RVAL)
  161.     call aryrd(200,RFLAG)
  162. C
  163.     call intrd(XLNT)
  164.     call aryrd(900,TRAVEL)
  165.     call intrd(OLNT)
  166.     call aryrd(220,ODESC1)
  167.     call aryrd(220,ODESC2)
  168.     call aryrd(220,ODESCO)
  169.     call aryrd(220,OACTIO)
  170.     call aryrd(220,OFLAG1)
  171.     call aryrd(220,OFLAG2)
  172.     call aryrd(220,OFVAL)
  173.     call aryrd(220,OTVAL)
  174.     call aryrd(220,OSIZE)
  175.     call aryrd(220,OCAPAC)
  176.     call aryrd(220,OROOM)
  177.     call aryrd(220,OADV)
  178.     call aryrd(220,OCAN)
  179.     call aryrd(220,OREAD)
  180. C
  181.     call intrd(R2LNT)
  182.     call aryrd(20,O2)
  183.     call aryrd(20,R2)
  184. C
  185.     call intrd(CLNT)
  186.     call aryrd(25,CTICK)
  187.     call aryrd(25,CACTIO)
  188. C
  189.     do 990 i=1,25
  190.     cflag(i)=.TRUE.
  191.     call logrd(j)
  192.     if(j.EQ.0) CFLAG(i)=.FALSE.
  193. 990    continue
  194. C
  195.     call intrd(VLNT)
  196.     call aryrd(4,VILLNS)
  197.     call aryrd(4,VPROB)
  198.     call aryrd(4,VOPPS)
  199.     call aryrd(4,VBEST)
  200.     call aryrd(4,VMELEE)
  201. C
  202.     call intrd(ALNT)
  203.     call aryrd(4,AROOM)
  204.     call aryrd(4,ASCORE)
  205.     call aryrd(4,AVEHIC)
  206.     call aryrd(4,AOBJ)
  207.     call aryrd(4,AACTIO)
  208.     call aryrd(4,ASTREN)
  209.     call aryrd(4,AFLAG)
  210. C
  211.     call intrd(MBASE)
  212.     call intrd(MLNT)
  213. C
  214. C   The RTEXT array is not used here, and isn't read (it's used
  215. C   in "speak.F")
  216. C
  217.     call initnd
  218. C
  219. C INIT, PAGE 5
  220. C
  221. C THE INTERNAL DATA BASE IS NOW ESTABLISHED.
  222. C SET UP TO PLAY THE GAME.
  223. C
  224. 1025    CALL ITIME(SHOUR,SMIN,SSEC)        
  225.     CALL INIRND(or(SHOUR,or(SMIN,SSEC)))
  226. C
  227.     WINNER=PLAYER
  228.     LASTIT=AOBJ(PLAYER)
  229.     HERE=AROOM(WINNER)
  230.     THFPOS=OROOM(THIEF)
  231.     BLOC=OROOM(BALLO)
  232.     INIT=.TRUE.
  233. #ifdef debug
  234. C
  235. C    Normally, PRSFLG is setable in gdt to allow seeing various
  236. C    parse results.  Since the pdp version does not have gdt,
  237. C    PRSFLG is set to show full debugging info when debug is enabled.
  238. C
  239.     PRSFLG=65535
  240. #endif debug
  241. C
  242. C
  243.     RETURN
  244. C INIT, PAGE 6
  245. C
  246. C ERRORS-- INIT FAILS.
  247. C
  248. 1925    continue
  249.     END
  250. #else PDP
  251. 10000    INIT=.FALSE.
  252. C                        !ASSUME INIT FAILS.
  253.     MMAX=1050
  254. C                        !SET UP ARRAY LIMITS.
  255.     OMAX=220
  256.     RMAX=200
  257.     VMAX=4
  258.     AMAX=4
  259.     CMAX=25
  260.     FMAX=46
  261.     SMAX=22
  262.     XMAX=900
  263.     R2MAX=20
  264.     DIRMAX=15
  265. C
  266.     MLNT=0
  267. C                        !INIT ARRAY COUNTERS.
  268.     OLNT=0
  269.     RLNT=0
  270.     VLNT=0
  271.     ALNT=0
  272.     CLNT=0
  273.     XLNT=1
  274.     R2LNT=0
  275. C
  276.     LTSHFT=10
  277. C                        !SET UP STATE VARIABLES.
  278.     MXSCOR=LTSHFT
  279.     EGSCOR=0
  280.     EGMXSC=0
  281.     MXLOAD=100
  282.     RWSCOR=0
  283.     DEATHS=0
  284.     MOVES=0
  285.     PLTIME=0
  286.     MUNGRM=0
  287.     HS=0
  288.     PRSA=0
  289. C                        !CLEAR PARSE VECTOR.
  290.     PRSI=0
  291.     PRSO=0
  292.     PRSCON=1
  293.     OFLAG=0
  294. C                        !CLEAR ORPHANS.
  295.     OACT=0
  296.     OSLOT=0
  297.     OPREP=0
  298.     ONAME=0
  299.     THFFLG=.FALSE.
  300. C                        !THIEF NOT INTRODUCED BUT
  301.     THFACT=.TRUE.
  302. C                        !IS ACTIVE.
  303.     SWDACT=.FALSE.
  304. C                        !SWORD IS INACTIVE.
  305.     SWDSTA=0
  306. C                        !SWORD IS OFF.
  307. C
  308.     RECNO=1
  309. C                        !INIT DB FILE POINTER.
  310.     MBASE=0
  311. C                        !INIT MELEE BASE.
  312. C   LOGICAL UNIT NRS: 5=STDIN, 6=STDOUT
  313.     INPCH=5
  314. C                        !TTY INPUT
  315.     OUTCH=6
  316.     DBCH=2
  317. C                        !DATA BASE.
  318. C INIT, PAGE 3
  319. C
  320. C INIT ALL ARRAYS.
  321. C
  322.     DO 5 I=1,CMAX
  323. C                        !CLEAR CLOCK EVENTS
  324.       CFLAG(I)=.FALSE.
  325.       CTICK(I)=0
  326.       CACTIO(I)=0
  327. 5    CONTINUE
  328. C
  329.     DO 10 I=1,FMAX
  330. C                        !CLEAR FLAGS.
  331.       FLAGS(I)=.FALSE.
  332. 10    CONTINUE
  333.     BUOYF=.TRUE.
  334. C                        !SOME START AS TRUE.
  335.     EGYPTF=.TRUE.
  336.     CAGETF=.TRUE.
  337.     MR1F=.TRUE.
  338.     MR2F=.TRUE.
  339.     FOLLWF=.TRUE.
  340.     DO 12 I=1,SMAX
  341. C                        !CLEAR SWITCHES.
  342.       SWITCH(I)=0
  343. 12    CONTINUE
  344.     ORMTCH=4
  345. C                        !NUMBER OF MATCHES.
  346.     LCELL=1
  347.     PNUMB=1
  348.     MDIR=270
  349.     MLOC=MRB
  350.     CPHERE=10
  351. C
  352.     DO 15 I=1,R2MAX
  353. C                        !CLEAR ROOM 2 ARRAY.
  354.       RROOM2(I)=0
  355.       OROOM2(I)=0
  356. 15    CONTINUE
  357. C
  358.     DO 20 I=1,XMAX
  359. C                        !CLEAR TRAVEL ARRAY.
  360.       TRAVEL(I)=0
  361. 20    CONTINUE
  362. C
  363.     DO 30 I=1,VMAX
  364. C                        !CLEAR VILLAINS ARRAYS.
  365.       VOPPS(I)=0
  366.       VPROB(I)=0
  367.       VILLNS(I)=0
  368.       VBEST(I)=0
  369.       VMELEE(I)=0
  370. 30    CONTINUE
  371. C
  372.     DO 40 I=1,OMAX
  373. C                        !CLEAR OBJECT ARRAYS.
  374.       ODESC1(I)=0
  375.       ODESC2(I)=0
  376.       ODESCO(I)=0
  377.       OREAD(I)=0
  378.       OACTIO(I)=0
  379.       OFLAG1(I)=0
  380.       OFLAG2(I)=0
  381.       OFVAL(I)=0
  382.       OTVAL(I)=0
  383.       OSIZE(I)=0
  384.       OCAPAC(I)=0
  385.       OCAN(I)=0
  386.       OADV(I)=0
  387.       OROOM(I)=0
  388. 40    CONTINUE
  389. C
  390.     RDESC2=0
  391. C                        !CLEAR DESC BASE PTR.
  392.     DO 50 I=1,RMAX
  393. C                        !CLEAR ROOM ARRAYS.
  394.       RDESC1(I)=0
  395.       RACTIO(I)=0
  396.       RFLAG(I)=0
  397.       RVAL(I)=0
  398.       REXIT(I)=0
  399. 50    CONTINUE
  400. C
  401.     DO 60 I=1,MMAX
  402. C                        !CLEAR MESSAGE DIRECTORY.
  403.       RTEXT(I)=0
  404. 60    CONTINUE
  405. C
  406.     DO 70 I=1,AMAX
  407. C                        !CLEAR ADVENTURER'S ARRAYS.
  408.       AROOM(I)=0
  409.       ASCORE(I)=0
  410.       AVEHIC(I)=0
  411.       AOBJ(I)=0
  412.       AACTIO(I)=0
  413.       ASTREN(I)=0
  414.       AFLAG(I)=0
  415. 70    CONTINUE
  416. C
  417.     DBGFLG=0
  418.     PRSFLG=0
  419.     GDTFLG=0
  420. C
  421. C allow setting gdtflg true if user id matches wizard id
  422. C this way, the wizard doesn't have to recompile to use gdt
  423. C
  424.     if (getuid() .eq. WIZARDID) gdtflg=1
  425. C
  426.     FROMDR=0
  427. C                        !INIT SCOL GOODIES.
  428.     SCOLRM=0
  429.     SCOLAC=0
  430. C INIT, PAGE 4
  431. C
  432. C NOW RESTORE FROM EXISTING INDEX FILE.
  433. C
  434.     OPEN(UNIT=1,file=INDXFILE,status='OLD',
  435. &        FORM='FORMATTED',ACCESS='SEQUENTIAL',ERR=1900)
  436.     READ(1,130) I,J,K
  437. C                        !GET VERSION.
  438.     IF((I.NE.VMAJ).OR.(J.NE.VMIN))
  439. &        GO TO 1925
  440.  
  441.     OPEN(UNIT=DBCH,file=TEXTFILE,status='OLD',
  442. &        FORM='UNFORMATTED',ACCESS='DIRECT',
  443. &        recl=76,ERR=1950)
  444.  
  445. #ifdef debug
  446.     PRINT 150
  447. 150    FORMAT(' RESTORING FROM "dindx.dat"')
  448. #endif debug
  449.     READ(1,130) MXSCOR,STRBIT,EGMXSC
  450.     READ(1,130) RLNT,RDESC2,RDESC1,REXIT,RACTIO,RVAL,RFLAG
  451.     READ(1,130) XLNT,TRAVEL
  452.     READ(1,130) OLNT,ODESC1,ODESC2,ODESCO,OACTIO,OFLAG1,OFLAG2,
  453. &        OFVAL,OTVAL,OSIZE,OCAPAC,OROOM,OADV,OCAN,
  454. &        OREAD
  455.     READ(1,130) R2LNT,OROOM2,RROOM2
  456.     READ(1,130) CLNT,CTICK,CACTIO
  457.     READ(1,135) CFLAG
  458.     READ(1,130) VLNT,VILLNS,VPROB,VOPPS,VBEST,VMELEE
  459.     READ(1,130) ALNT,AROOM,ASCORE,AVEHIC,AOBJ,AACTIO,ASTREN,AFLAG
  460.     READ(1,130) MBASE,MLNT,RTEXT
  461. C
  462.     CLOSE(1)
  463.     GO TO 1025
  464. C                        !INIT DONE.
  465. C
  466. C 130    FORMAT(I8)
  467. 130    FORMAT(I6)
  468. 135    FORMAT(L4)
  469. C INIT, PAGE 5
  470. C
  471. C THE INTERNAL DATA BASE IS NOW ESTABLISHED.
  472. C SET UP TO PLAY THE GAME.
  473. C
  474. 1025    CALL ITIME(SHOUR,SMIN,SSEC)
  475. C                        !GET TIME AND DATE.
  476. C    CALL IDATE(I,J,K)
  477.     CALL IDATE(DATARRY(1))
  478.     CALL INIRND(or(DATARRY(1),or(DATARRY(2),DATARRY(3))),
  479. &        or(SHOUR,or(SMIN,SSEC)))
  480. C
  481.     WINNER=PLAYER
  482.     LASTIT=AOBJ(PLAYER)
  483.     HERE=AROOM(WINNER)
  484.     THFPOS=OROOM(THIEF)
  485.     BLOC=OROOM(BALLO)
  486.     INIT=.TRUE.
  487. C
  488. #ifdef debug
  489.     PRINT 1050,RLNT,RMAX,XLNT,XMAX,OLNT,OMAX,MLNT,MMAX,
  490. &      VLNT,VMAX,ALNT,AMAX,CLNT,CMAX,R2LNT,R2MAX
  491. 1050    FORMAT(' USED:'/1X,I5,' OF',I5,' ROOMS'/
  492. &      1X,I5,' OF',I5,' EXITS'/
  493. &      1X,I5,' OF',I5,' OBJECTS'/
  494. &      1X,I5,' OF',I5,' MESSAGES'/
  495. &      1X,I5,' OF',I5,' VILLAINS'/
  496. &      1X,I5,' OF',I5,' ADVENTURERS'/
  497. &      1X,I5,' OF',I5,' CLOCK EVENTS'/
  498. &      1X,I5,' OF',I5,' ROOM2 SLOTS')
  499.     PRINT 1150,MXSCOR,EGMXSC,RECNO,RDESC2,MBASE,STRBIT
  500. 1150    FORMAT(' MAX SCORE=',I5/' EG SCORE=',I5/
  501. &      ' MAX RECNO=',I5/' RDESC2 BASE=',I5/
  502. &      ' MELEE START=',I5/' STAR MASK=',I7)
  503.     PAUSE 1
  504. #endif debug
  505. C
  506.     RETURN
  507. C INIT, PAGE 6
  508. C
  509. C ERRORS-- INIT FAILS.
  510. C
  511. 1900    PRINT 910
  512.     PRINT 980
  513.     RETURN
  514. 1925    PRINT 920,I,J,K,VMAJ,VMIN,VEDIT
  515.     PRINT 980
  516.     RETURN
  517. 1950    PRINT 960
  518.     PRINT 980
  519.     RETURN
  520. 910    FORMAT(' I can''t open ',INDXFILE,'.')
  521. 920    FORMAT(' "dindx.dat" is version ',I1,'.',I1,A1,'.'/
  522. &        ' I require version ',I1,'.',I1,A1,'.')
  523. 960    FORMAT(' I can''t open ',TEXTFILE,'.')
  524. 980    FORMAT(' Suddenly a sinister, wraithlike figure appears before '
  525. &    'you,'/' seeming to float in the air.  In a low, sorrowful voice'
  526. &    ' he says,'/' "Alas, the very nature of the world has changed, '
  527. &    'and the dungeon'/' cannot be found.  All must now pass away."'
  528. &    '  Raising his oaken staff'/' in farewell, he fades into the '
  529. &    'spreading darkness.  In his place'/' appears a tastefully '
  530. &    'lettered sign reading:'//23X,'INITIALIZATION FAILURE'//
  531. &    ' The darkness becomes all encompassing, and your vision fails.')
  532. C
  533.     END
  534. C PROTCT-- CHECK FOR USER VIOLATION
  535. C
  536. C THIS ROUTINE SHOULD BE MODIFIED IF YOU WISH TO ADD SYSTEM
  537. C DEPENDANT PROTECTION AGAINST ABUSE.
  538. C
  539. C AT THE MOMENT, PLAY IS PERMITTED UNDER ALL CIRCUMSTANCES.
  540. C
  541.     LOGICAL FUNCTION PROTCT(X)
  542.     IMPLICIT INTEGER(A-Z)
  543. C
  544.     PROTCT=.TRUE.
  545.     RETURN
  546.     END
  547. #endif PDP
  548.